;<FOONEX>MFLOUT.MAC;3 18-Mar-81 20:29:08, Edit by MMCM
;<MON>MFLOUT.MAC;7     4-Mar-81 10:04:18    EDIT BY SWEER
;Added ERCAL/ERJMP handling and Normalization check
;<STROLLO>MFLOUT.MAC;4     9-OCT-75 15:40:31    EDIT BY STROLLO
;<STROLLO>MFLOUT.MAC;2    27-AUG-75 13:02:17    EDIT BY STROLLO
;<TENEX-132>MFLOUT.MAC;5    10-NOV-73 17:31:34	EDIT BY CLEMENTS
;<TENEX-130>MFLOUT.MAC;4     2-NOV-72 13:35:20	EDIT BY TOMLINSON

;14 JUN 71, 1246:
;D. MURPHY

;TENEX FLOATING OUTPUT CONVERSION AND FORMATTING ROUTINES

	SEARCH PROLOG,STENEX
	TITLE MFLOUT
	SWAPCD

	IFNDEF MONFLG,<MONFLG==1>
;FLOUT IS ASSEMBLED FOR MONITOR OR USE TESTING DEPENDING ON STATE OF
;MONFLG, 1 FOR MONITOR

	IFG MONFLG,<EXTERN MENTR,MRETN,BOUTA>

	ENTRY .DFOUT,.FLOUT,DXP.

	EXTERN EDFAD.,EDFMP.,EDFDV.	;X RANGE D P FL PT ARITH ROUTINES
;VARIABLES FOR FLOUT WHICH ARE SAVED ON STACK

CBD==0
CAD==1
SAVDIG==2
DX==3
CEXP==4
CFILL==5
BKSTK=16		;BACKPOINTER TO STACK, USED AS INDEX FOR VARIABLES
;LEFT HALF OF BKSTK USED TO STORE ERROR NUMBER


P=17		;CONTROL PUSHDOWN

EOL==37		;END-OF-LINE CHARACTER

;ABBREVIATED PDP-10 OP CODES

	OPDEF CALL [PUSHJ P,]
	OPDEF RET [POPJ P,]

;FLOUT., THE NUMBER PRINTING ROUTINE FOR TENEX.
;
;TAKS EX RANGE DOUBLE PRECISION FLOATING POINT NUMBER IN AC'S A AND
;A+1.
;STANDARD ("FREE") FORMAT USES DIGIT COUNT IN AC "SIG".
;"IN FORM" OUTPUT USES NUMBER OF DIGITS SPECIFIED BY FORMAT CTRL ARG. 
;FLOUT. IS TRANSPARENT TO AC'S 12,15,17 AND CLOBBERS ALL OTHERS.

;EXTERNAL VARIABLES USED

;TEM STORAGE LOACTIONS USED (EXTERNAL BECUASE REENTRANT):
;CBD(BKSTK)    COLUMNS IN FORMAT BEFORE DECIMAL POINT
;         (NUMBER OF #'S LESS 1 IF NEEDED FOR "-")
;CAD(BKSTK)    COLUMNS AFTER POINT (NUMBER OF #'S AFTER POINT)
;SAVDIG(BKSTK) DIGIT SAVED FOR USED AFTER C(ZERS) ZEROES PRINTED ("DIGIT")
;DX(BKSTK)     DECIMAL EXPONENT OF NUMBER


;AC USE IN FLOUT AND ITS SUBRS (PARENS ENCLOSE SUBR NAMES)
;0:	FLOATING FORMAT WORD
;1:	CHARACTER (FIELD, LCH), DIGIT DURING PRINTING

DIG==1
;2 CLOBBERED BY LCH, LATER NUMBER OF DIGITS TO PRINT

NDP==2
DF==3		;FLOUT'S INTERNAL FLAGS (NEXT PAGE)
BX==4		;BINARY EXPONENT (DXP). BX+1 IS ALSO USED.
DBD=4		;NUMBER OF DIGITS TO PRINT BEFORE DECIMAL POINT
DAD=5		;...AFTER
ZERS=6		; # OF LEADING ZEROS BEFORE (ADDITIONAL) SIGNIF DIGITS (DIGIT)
MINF==7		;AC FOR MINIMUM POWER OF TEN FOR F FORMAT CASE OF G FORMAT
MAXF==10;...MAXIMUM
M=10		;MEMORY OPERAND POINTER FOR FLOATING POINT ROUTINES
A=12		;A AND A+1 HOLD NUMBER DURING NORMALIZATION AND PRINTING
		;A MUST BE SAME AS USED BY FLOATING POINT ROUTINES.
T==11		;GENERAL TEMPORARY. 11 IS CLOBBERED BY EDFPT ROUTINES (3/7/69).
;14 IS CLOBBERED IN EDFPT ROUTINES (3/7/69)
;15,16,17 TRANSPARENT

;FLAGS USED IN DF. THOSE IN LH RELATE TO FORMAT SPECIFICATIONS:
;1      "-"
;2      "+"
;4      "*"
;10     "0"
;20     "$"
;40     "."
;100    PRINT EXPONENENT VALUE
;200    PRINT "E" IF 100 SET
;400    PRINT "*10^" IF 100 SET 
;1000	PRINT "D" IF 100 SET
;2000 FIRST CHAR POS EXP ALWAYS SIGN
;4000 FIRST CHAR POS EXP SPACE ON POS #
;10000 B0,1 OF FORMAT CONTROL 01 OR 11
;20000 WRAP AROUND FIELD 1 FOR LEFT JUSTIFICATION
;40000 PRINT AT LEAST ONE DIGIT IN FIELD 1
;100000 OPTIONAL 0 IN FIELD 1 FOR ARG =0
;400000 SUPPRESS LEADING SPACES IN FREE FORMAT

;FLAGS IN RH OF DF
;1      NUMBER IS NEGATIVE
;2      SUPPRESS TRAILING ZEROS, NON-SIG ".", AND SPACE AND 0 IN EXPONENT
;4      NUMBER ALREADY ROUNDED ("ROUND" CAN GET CALLED TWICE)
;10     SET IF ON SECOND SCAN TO FIND FIELD (FOR "NO FIELDS" ERROR MSG)
;20 DO OUTPUT ON COLUMN OVERFLOW
;100 FORCED FREE FORMAT OR EXPANDED EXPONENT
;B18-B22 RESERVED FOR PRECISION SPEC


.DFOUT:	IFG MONFLG,<JSYS MENTR>
	MOVE A,2
	MOVE A+1,3
	MOVE 0,4
	PUSHJ P,FLOUT.
	JRST DFOUTX
	AOS (P)
.DFOT1:	IFG MONFLG,<
	JRST MRETN>
	IFLE MONFLG,<
	POPJ P,>
DFOUTX:	IFG MONFLG<
	HLRZ T,BKSTK
	UMOVEM T,4>
	JRST MRTNE1##		; Handle ERCAL/ERJMP

.FLOUT:	IFG MONFLG,<JSYS MENTR>
	MOVE A,2
	SETZ A+1,
	MOVE 0,3
	PUSHJ P,FLOUT.
	JRST FLOUTX
	AOS (P)
.FLOT1:	IFG MONFLG,<
	JRST MRETN>
	IFLE MONFLG,<
	POPJ P,>
FLOUTX:	IFG MONFLG,<
	HLRZ T,BKSTK
	UMOVEM T,3>
	JRST MRTNE1##		; Handle ERCAL/ERJMP

	IFG MONFLG,<
.CO:	PUSH P,2
	MOVE 2,DIG		;CHARACTER FOR OUTPUT GOES IN 2
	UMOVE 1,1		;DEST DESIG'RET GOES IN 1
	PUSHJ P,BOUTA		;BOUT WITHOUT CHANGING CLFMMON FLAG
	MOVE DIG,2
	POP P,2
	POPJ P,
>
	IFLE MONFLG,<
.CO:	PBOUT
	POPJ P,>

ILLFMT:	HRLI BKSTK,FLOTX3
	CALL FIXSTK		;FIX UP THE STACK THEN RETURN
	POPJ P,0
RGOOD:	AOS (P)
RBAD:	POPJ P,0
TOOSML:	HRLI BKSTK,FLOTX1
	CALL FIXSTK		;FIX UP THE STACK FIRST
	TRNE DF,100		;SHOULD BE IMPOSSIBLE FOR FORCED FREE OR EXP
			;EXPAND TO GET HERE BUT AVOID POSSIBLE DISASTERS
	JRST RGOOD		;REALLY BAD RETURN EFFECTIVELY
	TRNN DF,20
	POPJ P,		;NO OUTPUT ON COLUMN OVERFLOW
	TLZ DF,777777		;FORCED FREE OUTPUT, COLUMN OVERFLOW
	TRZ DF,777772
	TRO DF,100		;SET FORCED FLAG
	SETZ 0,		;AND FORCE FREE
	SOS (P)		;FORCE BAD RETURN
	CALL UPSTK
	JRST FLOUTF		;AND GO AGAIN


EXPOVF:	HRLI BKSTK,FLOTX2
	CALL FIXSTK		;FIX UP THE STACK
	TRNE DF,100
	JRST RGOOD		;AGAIN REALLY BAD RETURN EFFECTIVELY
	TRNN DF,20
	POPJ P,		;NO ADDITIONAL OUTPUT, COLUMN OVERFLOW
	TRO DF,100		;SET FORCED EXP EXPAND FLAG
	SOS (P)		;FORCE BAD RETURN
	CALL UPSTK
	MOVEI T,5
	MOVEM T,CEXP(BKSTK)
	JRST PX0
UPSTK:	POP P,T
	HRRI BKSTK,1(P)		;BACKPOINTER TO STACK
	ADD P,[XWD 6,6]		;NOW UPDATE STACK POINTER BY 6
	IFG MONFLG,<
	EXTERN MSTKOV
	JUMPGE P,MSTKOV>
	JRST 0(T)


;TENEX NUMERIC OUTPUT ROUTINE, COMMENTS ON PREVIOUS 2 PAGES

FLOUT.:	SETZ DF,		;CLEAR ALL .FLOUT'S INTERNAL FLAGS
	SKIPGE A
	TRO DF,1		;FLAG FOR NEGATIVE ARGUMENT
	TRNE DF,1
	DFN A,A+1		;MAKE ARGUMENT POSITIVE
	CALL UPSTK
;CONVERT ARGUMENT TO DECIMAL EXPONENT IN DX(BKSTK) AND FRACTION IN A, A+1

	CALL DXP

;IS OUTPUT TO BE FREE FORMAT?

FLOUTF:	TRNE 0,777777		;0 SPEC FOR RIGHT HALF IMPLIES FREE
	JRST DECODE		;NO
;THE NEXT 5 INSTRUCTIONS DETERMINE TENEX'S STANDARD FORMAT.

	MOVNI MINF,3		;USE F FORMAT IF ARG >=10^-3 AND
	MOVEI MAXF,6		;...<=10^6, OTHERWISE USE E FORMAT.
	LDB NDP,[POINT 5,0,17]
	SKIPN NDP
	MOVEI NDP,^D7		;STANDARD NUMBER OF SIGNIFICANT DIGITS
	TLO DF,400201		;PRINT "E" IF EXPONENT PRINTED,
		;PRINT SPACE IF POSITIVE, "-" IF NEGATIVE
	TLNE 0,(1B6)		;POINT REQUESTED?
	TLO DF,40		;YES, FORCE IT
	TRO DF,2		;SUPPRESS TRAILING ZEROS, POINT, ETC.
	MOVEI T,4
	MOVEM T,CEXP(BKSTK)
	JRST G		;TO G FORMAT ROUTINE



DECODE:	SETZM CBD(BKSTK)
	LDB T,[POINT 2,0,1]
	SKIPE T
	SOS CBD(BKSTK)		;SIGN WILL ALWAYS BE PRINTED SO LEAVE SPACE
	CAIN T,2
	TLO DF,2		;ALWAYS PRINT SIGN
	TRNE T,1
	TLO DF,10001
DCODE1:	LDB T,[POINT 2,0,3]
	CAIN T,0
	JRST DCODE2		;NORMAL SPACE FILL TO LEFT
	CAIN T,1
	TLO DF,10		;0 FILL
	CAIN T,2
	TLO DF,4		;* FILL
	CAIN T,3
	TLO DF,20000		;WRAP AROUND FIELD 1
DCODE2:	TLNE 0,(1B4)
	TLO DF,40000		;PRINT AT LEAST ONE DIGIT FIELD
	TLNE 0,(1B12)
	TLO DF,100000	;IF 1B4=0 THEN SUPPRESS POSSIBLE 0
				;IN FIELD 1 ON ARG=0
	TLNN 0,(1B5)
	JRST .+3
	SOS CBD(BKSTK)
	TLO DF,20		;$ PREFIX
	TDNE 0,[1B6+77B29]	;FIELD 2 OR POINT REQUESTED?
	TLO DF,40		;YES, PRINT POINT
	SETZM CEXP(BKSTK)
	LDB T,[POINT 2,0,8]
	CAIE T,0
	JRST .+4
	TRNE 0,77
	JRST ILLFMT		;ROOM IN FIELD 3 BUT NO EXP DESIRED
	JRST DCODE5		;NO EXP FIELD
	TLO DF,100
	TRNN 0,76
	JRST ILLFMT		;NO ROOM FOR EXP
	CAIN T,1
	TLO DF,200		;PRINT E THEN EXP
	CAIN T,2
	TLO DF,1000		;PRINT D THEN EXP
	SOS EXP
	CAIE T,3
	JRST DCODE4
	TRNN 0,74
	JRST ILLFMT		;NO ROOM
	HRROI T,-3
	ADDM T,CEXP(BKSTK)
	TLO DF,400		;"*10^" THEN EXP

DCODE4:	LDB T,[POINT 2,0,10]
	CAIN T,0
	JRST DCODE5		;NORMAL EXP FIELD
	CAIN T,1
	TLO DF,2000		;FIRST CHAR POS EXP ALWAYS SIGN
	CAIN T,2
	TLO DF,4000
DCODE5:	TLNE 0,(1B11)
	TRO DF,20
DCODE6:	LDB T,[POINT 6,0,23]
	ADDM T,CBD(BKSTK)
	LDB T,[POINT 6,0,29]
	MOVEM T,CAD(BKSTK)
	LDB T,[POINT 6,0,35]
	ADDM T,CEXP(BKSTK)
	LDB T,[POINT 5,0,17]
	DPB T,[POINT 5,DF,22]

;BEGINNING OF SECTION TO SET UP PRINTING PARAMETERS (DBD,DAD,ZERS),
;AS A FUNCTION OF FORMAT SPECIFIED AND OF THE VALUE OF THE ARGUMENT

;FIRST, IF THE NUMBER IS NEGATIVE BUT FORMAT CONTAINED NEITHER + NOR -,
;REDUCE COLUMNS BEFORE POINT BY 1 TO ALLOW FOR - SIGN.

	TRNE DF,1		;TEST FOR NOT NEGATIVE
	TLNE DF,3
	JRST SETU1		;"+" OR "-" IN FORMAT
	SOSLE CBD(BKSTK)	;REDUCE COLUMNS LEFT FOR DIGITS BEFORE POINT
	JRST SETU1		;STILL SPACE FOR AT LEAST ONE DIGIT B4 . .
		;EXPAND FIELD IF NECESSARY TO MAKE ROOM FOR -
	SKIPE CBD(BKSTK)	;WAS THERE A COLUMN BEFORE POINT ?
	SETZM CBD(BKSTK)	;NO, COULD MAKE ERROR COMMENT HERE.
	SKIPG CAD(BKSTK)	;ARE THERE ANY COLUMNS AFTER POINT ?
	AOS CBD(BKSTK)		;NO, PUT ONE BEFORE POINT

;GO TO F FORMAT ROUTINE IF NO EXPONENT WAS SPECIFIED IN FORMAT

SETU1:	TLNN DF,100
	JRST XXXXXF

;SET UP FOR E FORMAT:	OUTPUT WITH EXPONENT

	SETZ ZERS,		;NO LEADING ZEROS
	MOVE DBD,CBD(BKSTK)	;USE ALL AVAILABLE COLUMNS BEFORE POINT,
	MOVE DAD,CAD(BKSTK)		;AND  AFTER.
	JUMPE A,EZER		;TEST FOR ZERO ARGUMENT
	MOVN T,DBD		;REDUCE EXPONENT FOR DIGITS BEFORE POINT
	ADDM T,DX(BKSTK)
E1:	MOVE NDP,DBD
	ADD NDP,DAD		;COMPUTE # SIG DIGITS = # DIGITS BEING PRINTED
	CALL ROUND		;ROUND CO NDP DIGITS
	JRST .+1		;OV DURING ROUND, HANDLING IN ROUND IS OK.
	JRST PRINT		;GO PRINT NUMBER

EZER:	SETZ DBD,
	TLNE DF,40000
	MOVEI DBD,1		;NUMBER IS ZERO, PRINT ONE 0 BEFORE POINT,
	JRST E1		;LEAVE EXPONENT ZERO.

;F FORMAT - NO EXPONENT.

XXXXXF:	SKIPG DBD,DX(BKSTK)	;TEST FOR NBR <1. IF >=1, EXPONENT IS DIGS B4 "."
	JRST FSMAL
	CAMLE DBD,CBD(BKSTK)
	JRST TOOSML		;FIELD ONE TOO SMALL
	MOVE DBD,DX(BKSTK)		;EXPONENT IS NUMBER OF DIGITS BEFORE .
	SETZ ZERS,		;NO LEADING ZEROES
	MOVE DAD,CAD(BKSTK)	;USE ALL COLUMNS AFTER DECIMAL FOR DIGITS
	JRST FROUN		;GO ROUND

FSMAL:	SETZ DBD,		;DX(BKSTK) <= O. NO DIGITS BEFORE POINT.
	MOVM ZERS,DX(BKSTK)	;LEADING ZEROS=MIN(ABS(DX(BKSTK)),CAD(BKSTK))
	CAMLE ZERS,CAD(BKSTK)		;..
	MOVE ZERS,CAD(BKSTK)		;..
	MOVE DAD,CAD(BKSTK)	;FIELD AFTER . IS DIGITS. (DAD INCLUDES 0S)
;IF NUMBER IS ZERO, OR IF NO COLUMNS AFTER "." (ALL NUMBERS HERE ARE <1),
;THEN PRINT ONE ZERO BEFORE ".".

	TLNE DF,40000
	JRST FSMAL1
	TLNN DF,100000
	JUMPE A,FSMAL1		;NUMBER ZERO?
	SKIPN CAD(BKSTK)	;NO, ARE THERE NO COLUMNS AFTER . ?
FSMAL1:	SKIPG CBD(BKSTK)	;YES (ON ONE OR THE OTHER), ANY SPACE BEFORE .?
	JRST FROUN
	AOS DBD		;YES, SAY PRINT A DIGIT BEFORE .
	AOS ZERS		;MAKE THAT DIGIT A ZERO.

FROUN:	MOVE NDP,DBD		;COMPUTE # SIG DIGITS = # DIGS BEFORE POINT,
	ADD NDP,DAD		;...PLUS NUMBER AFTER.,
	SUB NDP,ZERS		;...MINUS LEADING ZEROS
	CALL ROUND		;ROUND TO NDP DIGITS AND SKIP UNLESS OVERFLOW
	JRST XXXXXF		;ON ROUNDING OVERFLOW MUST RE-SETUP FORMAT.
	JRST PRINT		;GOOD RETURN, GO PRINT NUMBER.

;"G FORMAT" - THAT IS USE F FORMAT IF NUMBER IN RANGE, OTHERWISE E 
;FORMAT.  USED FOR TENEX STANDARD FORMAT, INCLUDING MODIFIED
;STANDARD FORMAT FOR "PLOT ON" COMMAND.  USES FORMAT
;SUCH THAT DECIMAL POINTS OF ALL NUMBERS LINE UP (FOR SAME MINF,MAXF).
;AC'S THAT MUST BE SET BEFORE COMING HERE:
;  MINF:	SMALLEST POWER OF TEN FOR F FORMAT
;  MAXF:	LARGEST DITTO
;  NDP:	NUMBER OF SIGNIFICANT DIGITS TO PRINT
;ALSO FLAGS IN DF SHOULD BE PRESET FOR SUPPRESSION, *10^, POINT, ETC.

G:	CALL ROUND		;ROUND TO NDP DIGITS 1ST CAUSE CAN CHANGE DX.
	JRST .+1
	MOVEM MAXF,CBD(BKSTK)		;COLUMNS BEFORE DECIMAL (E OR F FORMAT)
	MOVE T,NDP	;NDP-DX(BKSTK) COLUMNS AFTER POINT IS EXACTLY ENOUGH
	SUB T,DX(BKSTK)		;FOR A TOTAL OF NDP DIGITS.
	MOVEM T,CAD(BKSTK)
	CAMG MINF,DX(BKSTK)
	CAMGE MAXF,DX(BKSTK)
	JRST .+2
	JRST XXXXXF		;DECIMAL EXPONENT IN RANGE, USE F FORMAT
	MOVEI DBD,1		;E FORMAT REQUIRED. 1 DIGIT BEFORE POINT.
	MOVEI DAD,-1(NDP)		;REST OF DIGITS AFTER POINT.
	SOS DX(BKSTK)		;REDUCE EXPONENT BECUASE OF THE DIGIT BEFORE .
	SETZ ZERS,		;NO LEADING ZEROS
	TLO DF,100		;SAY PRINT EXPONENT

;NOW PRINT THE NUMBER. THE ORDER OF THINGS IS:
;  LEADING BLANKS IF NO * NOR 0'S SPECIFIED,
;  SIGN, * OR 0 FILL, $,
;  DIGITS, POINT, MORE DIGITS,
;  E OR "*10^", EXPONENT SIGN, EXPONENT MAGNITUDE.

PRINT:	MOVE T,CBD(BKSTK)	;NUMBER OF FILL CHARACTERS = COLUMNS BEFORE POINT
	SUB T,DBD		;...MINUS DIGITS BEFORE POINT.
	MOVEM T,CFILL(BKSTK)
	JRST PR1
;FILL WITH SPACES IF NEITHER * NOR 0'S SPECIFIED AND NOT SUPPRESSED

	MOVEI DIG," "
	TLNN DF,420000		;FLAG TO SUPPRESS LEADING SPACES
	CALL .CO		;PRINT A SPACE
PR1:	TLNN DF,14		;SKIP IF * OR 0 SPECIFIED
	SOJGE T,.-4
;SIGN:	- IF NEGATIVE, "+", " ", OR NOTHING IF PLUS.

	TRNE DF,1		;IS NUMBER NEGATIVE?
	JRST PR2		;YES
	TLNE DF,500000		;"NO LEADING SPACES" MODE?
	JRST PR4		;YES, PRINT NOTHING FOR SIGN OF POS NUMBER.
	MOVEI DIG," "
	TLNE DF,1
	CALL .CO		;SPACE FOR "-" IN FORM
	MOVEI DIG,"+"
	TLNE DF,2
	CALL .CO		; + FOR + IN FORM IF NUMBER +
	JRST PR4
PR2:	MOVEI DIG,"-"		; - FOR ANY NEGATIVE NUMBER
	CALL .CO
	JRST PR4
;FILL WITH * OR 0 IF SO SPECIFIED (COUNT SET UP IN T ABOVE)

PR3:	TLNE DF,20000		;TRAILING BLANKS?
	JRST PR4+1		;YES
	MOVEI DIG,"*"
	TLNE DF,4
	CALL .CO		; * FILL
	MOVEI DIG,"0"
	TLNE DF,10
	CALL .CO		; 0 FILL
PR4:	SOJGE T,PR3
; $ IF SPECIFIED

	MOVEI DIG,"$"
	TLNE DF,20
	CALL .CO
;DIGITS, POINT, AND MORE DIGITS:
;ON FLAG SUPPRESS TRAILING 0'S AFTER . AND . IF ONLY 0'S AFTER IT.

	SETZM SAVDIG(BKSTK);INIT DIGIT ROUTINE:	MAKES SURE LAST LEADING 0 IS 0
	JRST PR6

PR5:	CALL DIGIT		;DIGITS BEFORE POINT
	JRST .+1		;PRINT NON-SIGNIFICANT ZEROES BEFORE POINT
	ADDI DIG,60		;CONVERT TO ASCII THEN PRINT
	CALL .CO
PR6:	SOJGE DBD,PR5
	CALL DIGIT		;GET NEXT DIGIT, SKIP IF SIGNIFICANT
	JRST PR6A		;GETS HERE IF DIGIT AFTER POINT IS
				;TRAILING ZERO AND TZ'S BEING SUPPRESSED
	TRNN DF,2		;ARE TRAILING ZEROES BEING SUPPRESSED?
	JRST PR6C		;NO
				;YES SO ALWAYS PRINT "."
PR6B:	PUSH P,DIG		;SAVE DIGIT
	MOVEI DIG,"."
	CALL .CO		;PRINT POINT
	POP P,DIG
	JRST PR8

PR7:	ADDI DIG,60		;PRIN DIGIT
	CALL .CO
	CALL DIGIT		;DIGITS AFTER POINT
	JRST PEXP		;ON SUPPRESSED TRAILING 0 GO DO EXPONENT
PR8:	SOJGE DAD,PR7

;PRINT EXPONENT IF SPECIFIED

PEXP:	TLNN DF,100		;FLAGS 200 OR 400 WO 100 MUST BE IGNORED.
	JRST PX6		;NO EXPONENT, DONE PRINTING
	TLNN DF,6000
	SKIPGE DX(BKSTK)
	SOS CEXP(BKSTK)
	MOVM 1,DX(BKSTK)
	SETZ T,
	IDIVI 1,^D10
	AOS T
	JUMPG 1,.-2
	CAMLE T,CEXP(BKSTK)
	JRST EXPOVF
PX0:	TLNN DF,400		;"*10^" FLAG OVERIDES E FLAG.
	JRST PX1
	MOVEI DIG,"*"
	CALL .CO
	MOVEI DIG,"1"
	CALL .CO
	MOVEI DIG,"0"
	CALL .CO
	MOVEI DIG,"^"
	CALL .CO
	JRST PX2
PX1:	MOVEI DIG,"E"
	TLNE DF,200		;200 BUT NOT 400 SAYS PRINT "E"
	CALL .CO
	MOVEI DIG,"D"
	TLNE DF,1000
	CALL .CO
;EXPONENT SIGN:	SUPPRESS PLUS IF "SUPPRESS" FLAG ON

PX2:	MOVE 1,DX(BKSTK)		;GET EXPONENT
	JUMPL 1,PX3
	MOVEI DIG," "
	TLNE DF,4000
	CALL .CO
	MOVEI DIG,"+"
	TRNE DF,2
	JRST .+3
	TLNE DF,2000		;SIGN ALWAYS IN EXP?
	CALL .CO
	MOVE 1,DX(BKSTK)
	JRST PX4
PX3:	MOVEI DIG,"-"
	CALL .CO
	MOVM 1,DX(BKSTK)		;TAKE ABSOLUTE VALUE OF EXPONENT
;PRINT EXPONENT VALUE:	LEADING 0'S IF NOT SUPPRESSED.

PX4:	MOVE 0,DF
	MOVE 2,1
	IFLE MONFLG,<
	MOVEI 1,101>
	SETZ 3,
	TRNN 0,2
	HRL 3,CEXP(BKSTK)
	HRRI 3,^D10
	TLO 3,400000
	TRNN 0,2
	TLO 3,140000
	IFLE MONFLG,<
	NOUT>
	IFG MONFLG,<
EXTERN NOUTXX
	CALL NOUTXX>
	JFCL		; CAN'T FAIL
	MOVE DF,0
PX6:	TLNN DF,20000
	JRST PDONE
	MOVE T,CFILL(BKSTK)
	JRST PX5
	MOVEI DIG," "
	CALL .CO
PX5:	SOJGE T,.-2

;PRINTING COMPLETE

PDONE:	CALL FIXSTK
	AOS (P)
	POPJ P,		;RETURN

FIXSTK:	POP P,M
	SUB P,[XWD 6,6]
	JRST (M)		;STACK NOW FIXED UP SO RETURN


;SUBROUTINE TO REDUCE NUMBER IN A AND A+1 TO DECIMAL EXPONENENT IN DX(BKSTK)
;AND FRACTION (DIGIT PART) IN A AND A+1, 1>FRACTION>=.1.

;METHOD IS TO DIVIDE OR MULTIPLY BY POWERS OF TEN UNTIL FRACTION IS IN
;RANGE. THEN DECIMAL EXPONENT IS SUM OF POWERS OF TEN USED.

;THIS SUBROUTINE IS USED INTERNALLY IN FLOUT 
;AND EXTERNALLY IN XP AND DP FUNCTIONS.

;CLOBBERS AC "T"

DXP.:	DXP:	SETZM DX(BKSTK)		;START WITH 0 DECIMAL EXPONENT
	JUMPE A,DXPR		;IF NUMBER IS 0 WE'RE DONE
;FIRST GET NUMBER OUT OF EXPTENDED RANGE BY OPERATING WITH
;10^50 (A RANDOM NUMBER BETWEEN 10^38 AND 10^76). WE DON'T CARE HOW
;SLOW THIS IS, ESPECIALLY NUMBERS OVER 10^99.

DXP1:	TLNN A+1,400000		;EXTENDED RANGE ?
	JRST DXP2		;NO
	MOVEI M,E50		;OPERAND FOR MULTIPLY OR DIVIDE
	TLNN A+1,200000		;TEST SIGN OF EXTENDED EXPONENT, REMEMBERING
	TLNN A+1,177000		;THAT EXPONENTS 0-33 ARE "NEGATIVE"
	JRST DXP1A
	CALL EDFDV.		;EXPONENT POSITIVE, DIVIDE.
	MOVEI T,^D50		;EXPONENT POSITIVE, INCREASE DEC EXP
DXP1B:	ADDM T,DX(BKSTK)
	JRST DXP1

DXP1A:	CALL EDFMP.		;EXPONENT NEGATIVE, MULTIPLY,
	MOVNI T,^D50		;AND DECREASE DECIMAL EXPONENT.
	JRST DXP1B

;IN NON-EXTENDED RANGE TEST BITS OF BINARY EXPONENT TO DETERMINE POWER
;OF 10 TO USE. FOR EACH LOOP GET BINARY EXPONENT FROM NUMBER AND JFFO
;ON IT.  TERMINATES ON BIN EXP OF 0, -1, OR -2, OR AFTER DIVIDING BY
;10 FOR BINARY EXPONENTS OF 1 OR 2 OR 3.

DXP2:	HLLZ BX,A		;GET BINARY EXPONENT
	TLZ BX,400777		;..
	TLZN BX,200000		;CONVERT FROM EXCESS 128
	JRST DXP4		;EXECUTED IF EXPONENT NEGATIVE
	JFFO BX,.+2
DXPR:	RET		;DONE IF BIN EXP =0
	MOVE T,IPTAB-1(BX+1)		;ADD POWER OF TEN TO DECIMAL EXPONENT
	ADDM T,DX(BKSTK)		;..
	LSH BX+1,1		;TABLE HAS 2-WORD ENTRIES
	MOVEI M,FPPTAB-2(BX+1)		;CHOOSE POWER OF TEN IN TABLE
	CALL EDFDV.		;DIVIDE BY POWER OF TEN
	CAMLE BX,[3000000000]
	JRST DXP2
	RET		;NOW DONE IF BIN EXP WAS 1,2,3 BEFORE DIVIDE

DXP4:	TLO BX,600000		;NEGATIVE EXPONENT. COMPLEMENT IT.
	MOVN BX,BX
	CAMG BX,[2000000000]
	RET		;DONE IF BIN EXP IS -1 OR -2.
	JFFO BX,.+1		;FIND HIEST SET BIT IN MAGNITUDE OF EXPONENT
	MOVN T,IPTAB-1(BX+1)		;SUBTRACT FROM DECIMAL EXPONENT
	ADDM T,DX(BKSTK)		;..
	LSH BX+1,1
	MOVEI M,FPPTAB-2(BX+1)
	CALL EDFMP.		;MULTIPLY BY POWER OF TEN
	JRST DXP2



;POWERS OF TEN FOR DXP AS INTEGERS, IN ORDER, FOR EXPONENT BITS 1 THRU 8

IPTAB:	DEC 38,19,9,4,2,1,1,1

;SAME POWERS OF 10 IN DOUBLE PRECISION FLOATING POINT

FPPTAB:	OCT 377454732312,344413241535		;10^38
	OCT 300425434430,245110475000		;10^19
	OCT 236734654500,0		;10^9
	OCT 216470400000,0		;10^4
	OCT 207620000000,0		;10^2
TEN:	OCT 204500000000,0		;10. THE LABEL "TEN" IS USED IN GETDIG.
	OCT 204500000000,0,204500000000,0		;2 MORE 10^S

E50:	OCT 047421541661,401277144456		;10^50

;SUBROUTINE TO ROUND FRACTION IN A,A+1 TO C(NDP) DIGITS.
;IF ROUNDING PRODUCES NUMBER >= 1, SUBSTITUTE .1 AND ADD
;1 TO DECIMAL EXPONENT IN DX(BKSTK) AND GIVE R1. R2 IN ALL OTHER CASES.
;ROUNDS AT 12TH DIGIT IF LARGER # DIGITS REQUESTED,
; BUT IF "PRECIS" >0, ALLOWS UP TO 14 DIGITS,
; OR IF <0, ROUNDS AT ACTUAL REQUEST OR NOT AT ALL IF REQUEST >17.
;NOP IF CALLED A SECOND TIME (2 CALLS OCCUR IF OV IN F FORMAT, AND ALWAYS
;IN F FORMAT CASE OF G FORMAT).

ROUND:	SKIPG NDP		;CHECK FOR 0-COL FIELD
	SKIPLE ZERS
	JRST .+2
	JRST TOOSML		;FIELD TOO SMALL
	LDB T,[POINT 5,DF,22]
	CAIN T,37
	JRST ROUN1		;NO MAXISUM IF PRECIS <0
	TRNN T,37
	MOVEI T,^D12		;USUAL MAX NUMBER OF DIGITS
	CAILE NDP,(T)		;COMPARE REUSTED # DIGITS TO MAXIMUM
	MOVEI NDP,(T)		;REDUCE REQUEST TO MAX
ROUN1:	TRON DF,4		;SET "ROUNDED" FLAG AND SKIP IF WAS SET
	CAILE NDP,^D17		;NO ROUND FOR MORE THAN 17 DIGITS
	JRST RGOOD
	JUMPE A,RGOOD		;EXIT IF NUMBER IS ZERO
	PUSH P,M		;MUST BE TRANS CAUSE M=MAXF
	MOVE M,NDP
	LSH M,1		;TABLE INDEX IS TWICE # DIGITS
	MOVEI M,RNDP(M)
	CALL EDFAD.		;ADD 0.5 TIMES PROPER POWER OF TEN
	POP P,M
	CAMGE A,[201000000000]		;NUMBER NOW >= 1 ?
	JRST RGOOD		;NO
	MOVE A,PNT1		;>=1. CHANGE TO 0.1
	MOVE A+1,PNT1+1
	AOS DX(BKSTK)		;INDEX EXPONENT
	RET		;RETURN 1

PNT1:	OCT 175631463146,142314631463		;0.1

RNDP:	OCT 200400000000,0		;5*10^-1
	OCT 174631463146,141314631462		;5*10^-2
	OCT 171507534121,136727024365		; -3
	OCT 166406111564,133570651767		;-4
	OCT 162643334272,127616103131		;-5
	OCT 157517436542,124161550740		;-6
	OCT 154414336750,121132755430		;-7
	OCT 150655376246,115536257220		;-8
	OCT 145527461670,112430214163		;-9
	OCT 142422701372,107023326450		;-10
	OCT 136667633766,103353675560		;-11
	OCT 133537657770,100274544450		;-12
	OCT 130431363140,075226752040		;-13
	OCT 124702270232,071044566400		;-14
	OCT 121550223341,066520453460		;-15
	OCT 116440165747,063563526053		;-16
	OCT 112715126245,057754211570		;-17
	OCT 107560736521,054443324452		;-18
		;OCT 144471113564,051351103524		;-19

;DIGIT SUBROUTINE.
;SKIPS AND RETURNS DIGIT (0-11) IN DIG EXCEPT NO SKIP IF DIGIT IS
;TRAILING (NON-SIGNIFICANT) ZERO AND "SUPPRESS TRAILING 0'S" FLAG
;IS ON.

;METHOD:	ON SEEING 0, CONVERTS ADDITIONAL DIGITS TO SEE IF ANY NO-0'S
;LEFT, STORES NUMBER OF INTERVENING ZEROES IN "ZERS", NON-0
;DIGIT THAT FOLLOWS ZEROS IN "SAVDIG(BKSTK)".

;AT ENTRY IF ZERS>0, ZERS IS DECREMENTED AND A 0 IS RETURNED EXCEPT
;IF ZERS WAS 1 SAVDIG(BKSTK) IS USED.  ZERS IS ALSO PRESET TO
;NUMBER OF LEADING 0'S FOR NUMBERS SUCH AS .001 OR 0.0.

;ALWAYS GIVES ZEROES AFTER C(NDP) CALLS

DIGIT:	JUMPE ZERS,DIG1		;JUMP IF NO SAVED ZEROES TO OUTPUT
	JUMPL NDP,RNSZ		;IF NO MORE SIG DIGITS, RETURN TRAILING 0
	SOJG ZERS,PSZ		;GO PRINT SIGNIF 0 UNLESS COUNT USED UP
	MOVE DIG,SAVDIG(BKSTK)	;PRINT SAVED DIGIT (THIS CELL IS INITIALLY ZERO)
	JRST RGOOD

DIG1:	SOJL NDP,RNSZ		;COUNT SIG DIGITS USED, RET 0 IF ALL GONE
	CALL GETDIG		;GET NEXT DIGIT FROM FRACTION
	JUMPN DIG,RGOOD		;R2 UNLESS ZERO

;ZERO SEEN. GET ADDITIONAL DIGITS TO SEE IF THIS 0 IS SIGNIFICANT OR NOT.
;"ZERS" IS ASSUMED 0 HERE  BETTER BE 0, NOT -1 !!!

DZER1:	AOS ZERS		;COUNT ZEROS FOR POSSIBLE LATER  OUTPUT
	SOJL NDP,RNSZ		;IF NO MORE DIGITS THIS ONE IS NON-SIGNIF
	CALL GETDIG		;NEXT DIGIT
	JUMPE DIG,DZER1		;LOOP IF ZERO
	MOVEM DIG,SAVDIG(BKSTK)		;FOUND SIG DIGIT TO PUT AFTER THE 0'S
PSZ:	SETZ DIG,		;RETURN SIGNIFICANT ZERO OR UNSUPPRESSED ZERO
	JRST RGOOD

;RETURN NON-SIGNIFICANT ZERO

RNSZ:	SETZ DIG,
	TRNE DF,2		;SUPPRESS TRAILING ZEROES FLAG
	JRST RBAD		;FLAG ON, NO SKIP
	JRST RGOOD

;GET NEXT DIGIT FROM FRACTION.
;METHOD:	MULTIPLY BY 10, SHIFT TO POSITION BINARY POINT, CHOP OFF
;4 BITS OF MANTISSA, PUT BACK A ZERO EXPONENT (NEEDN'T BE NORMALIZED).

GETDIG:	MOVEI M,TEN
	CALL EDFMP.		;FRACTION TIMES TEN
	LDB DIG,[POINT 8,A,8]		;EXPONENT
	TLZ A,777000		;REMOVE HI-ORDER EXPONENT
	ASH A+1,10		; " LO " "
	ASHC A,-200(DIG)	;LEFT SHIFT BY EXPONENT, PUTS BIN PT AFTER B8
	LDB DIG,[POINT 8,A,8]	;INTEGER BITS ARE DIGIT
	TLZ A,777000		;CREAM INTEGER PART
	TLO A,200000		;SUPPLY EXPONENT OF 200
	ASH A+1,-10
	TLO A+1,145000		;LO ORDER EXPONENT 200-33
	POPJ P,		;NEEDN'T BE NORMALIZED.


PR6A:	TLNE DF,40	;WANT TO PRINT POINT?
	JRST PR6B	;YES - GO DO IT AND DIGITS AFTER
	JRST PEXP	;NO, PRINT EXP FIELD
PR6C:	TLNE DF,40	;WANT TO PRINT POINT?
	JRST PR6B	;YES - GO DO IT AND DIGITS AFTER
	JRST PR8	;NO, JUST DO DIGITS AFTER
			;SHOULD ONLY GET HERE ON NO FIELD 2 REQUESTED
			;IN "FREE" FORMAT

;END OF FLOUT

	END